home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 002 / stf.arc / STF.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1984-11-01  |  4.6 KB  |  180 lines
  1. PROGRAM STF;  { Filter Input File to DOS Standard Text Format file }
  2.  
  3. {======================================================================}
  4. {                                                                      }
  5. {  STF.PAS      A DOS filter to convert files to Standard Text Format  }
  6. {                                                                      }
  7. {               Version:  1.0  20OCT84  Turbo Pascal                   }
  8. {                                                                      }
  9. {               Author:   Joseph E. Doran, Jr.                         }
  10. {                         145 Indian Hill Road                         }
  11. {                         Carlisle, MA 01741                           }
  12. {                         (617) 369-9312                               }
  13. {                                                                      }
  14. {               Usage:    STF <A:MESSY.DAT >B:STANDARD.TXT             }
  15. {                         (Refer to the DOS manual for a discussion    }
  16. {                         of filters.)                                 }
  17. {                                                                      }
  18. {======================================================================}
  19.  
  20. CONST
  21.   MaxLen = 254;  { maximum output record length }
  22.   EOF = ^Z;      { end-of-file marker; ctrl-Z }
  23.   EOL = ^M^J;    { end-of-line marker; carriage-return, line-feed }
  24.  
  25. TYPE
  26.   str255 = string[255];
  27.  
  28. VAR
  29.   StdBuffer, TxtBuffer: str255;
  30.   StdLength, StdByte, StdPos, TxtPos, TabStop, i: integer;
  31.  
  32.  
  33. PROCEDURE StdRead(Var StdData:Str255);  { Read from Standard Input }
  34.  
  35. TYPE
  36.   register = record
  37.     ax,bx,cx,dx,bp,si,di,ds,es,flags: integer;
  38.     END;
  39.  
  40. VAR
  41.   IntrArgs: register;
  42.   StdLen: byte absolute StdData;
  43.  
  44. BEGIN
  45.   WITH IntrArgs do
  46.     BEGIN
  47.       ax := $3F00;
  48.       bx := 0;
  49.       cx := 255;
  50.       ds := seg(StdData);
  51.       dx := ofs(StdData) + 1;
  52.       Intr($21,IntrArgs);
  53.       StdLen := ax;
  54.     END;
  55. END;
  56.  
  57.  
  58. PROCEDURE StdWrite(StdData:Str255);  { Write to Standard Output }
  59.  
  60. TYPE
  61.   register = record
  62.     ax,bx,cx,dx,bp,si,di,ds,es,flags: integer;
  63.     END;
  64.  
  65. VAR
  66.   IntrArgs: register;
  67.  
  68. BEGIN
  69.   WITH IntrArgs do
  70.     BEGIN
  71.       ax := $4000;
  72.       bx := 1;
  73.       cx := length(StdData);
  74.       ds := seg(StdData);
  75.       dx := ofs(StdData) + 1;
  76.       Intr($21,IntrArgs);
  77.     END;
  78. END;
  79.  
  80.  
  81. PROCEDURE ASCGraph;  { Process standard ASCII graphic characters }
  82.  
  83. BEGIN
  84.   TxtPos := TxtPos + 1;
  85.   If TxtPos > MaxLen then
  86.     BEGIN
  87.       StdWrite(copy(TxtBuffer,1,MaxLen)+EOL);
  88.       TxtPos := 1;
  89.     END;
  90.   TxtBuffer[TxtPos] := chr(StdByte);
  91. END;
  92.  
  93.  
  94. PROCEDURE HrzPaper;  { Simulate horizontal paper motion }
  95.  
  96. BEGIN
  97.   If StdByte in [8,127] then  { BS and DEL backspaces }
  98.     BEGIN
  99.       If TxtPos > 0 then TxtPos := TxtPos - 1;
  100.     END;
  101.   If StdByte = 9 then  { HT horizontal tab every eight spaces }
  102.     BEGIN
  103.       TabStop := (TxtPos div 8) * 8 + 8;
  104.       If TabStop > MaxLen then TabStop := MaxLen;
  105.       If TabStop > TxtPos then
  106.         BEGIN
  107.           For i := TxtPos + 1 to TabStop do TxtBuffer[i] := ' ';
  108.         END;
  109.       TxtPos := TabStop;
  110.     END;
  111. END;
  112.  
  113.  
  114. PROCEDURE VrtPaper;  { Simulate vertical paper motion }
  115.  
  116. BEGIN
  117.   If StdByte = 10 then  { LF line-feed }
  118.     BEGIN
  119.       If TxtPos > 0 then StdWrite(copy(TxtBuffer,1,TxtPos));
  120.       StdWrite(EOL);
  121.     END;
  122.   If StdByte = 11 then  { VT vertical tab }
  123.     BEGIN
  124.       If TxtPos > 0 then StdWrite(copy(TxtBuffer,1,TxtPos));
  125.       StdWrite(EOL+EOL+EOL);
  126.     END;
  127.   If StdByte = 12 then  { FF form feed }
  128.     BEGIN
  129.       If TxtPos > 0 then StdWrite(copy(TxtBuffer,1,TxtPos));
  130.       StdWrite(EOL+'.pa'+EOL);
  131.     END;
  132.   TxtPos := 0;
  133. END;
  134.  
  135.  
  136. PROCEDURE StdPurge;  { Purge miscellaneous control characters }
  137.  
  138. BEGIN
  139. END;
  140.  
  141.  
  142. BEGIN  { Mainline Processing }
  143.  
  144.   { create output text buffer }
  145.  
  146.   TxtPos := 0;
  147.   TxtBuffer := '';
  148.   For i := 1 to MaxLen do TxtBuffer := TxtBuffer+'X';
  149.  
  150.   { read/filter/write loop }
  151.  
  152.   Repeat
  153.     StdRead(StdBuffer);
  154.     StdLength := length(StdBuffer);
  155.     For StdPos := 1 to StdLength do
  156.       BEGIN
  157.         StdByte := ord(StdBuffer[StdPos]) and 127;
  158.         Case StdByte of
  159.           0..7:      StdPurge;
  160.           8..9:      HrzPaper;
  161.           10..12:    VrtPaper;
  162.           13..31:    StdPurge;
  163.           32..126:   ASCGraph;
  164.           127:       HrzPaper;
  165.         END;
  166.       END;
  167.   Until StdLength = 0;
  168.  
  169.   { flush last text buffer to output }
  170.  
  171.   If TxtPos > 0 then StdWrite(copy(TxtBuffer,1,TxtPos)+EOL);
  172.  
  173.   { write end-of-file marker }
  174.  
  175.   StdWrite(EOF);
  176.  
  177. END.
  178.  
  179. *** CREATED 10/26/84 08:59:08 BY $MS ***